PPPPPPPPPPPP 
PPPPPPPPPPPP 
PPPPPPPPPPPP 
P PP 


P PPP 
PPPPPPPPPPPP 
PPPPPPPPPPPP 
PPPPPPPPPPPP 


GG 
GGGGGGGGG 


GGGGGGGGGGGG 
GGGGGGGGGGGG 


GGGGGGGGGGGG 
GG 


GGGGGGGGG 
GGGGGGGGG 


Att tt St st Ht Ht SH Ht tS St HH St 
| LLL) 
AHHH St tt St St tS St tS tS 


LLLLLLLLLLLLLLL 
LLLLLLLLLLLLLLL 
LLLLLLLLLLLLLLL 


o 


Va 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
00 
09 
00 
00 


**F ILE**1D®*RPGDSPLY 

| 

| 

} Ps 
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RR RR PP PP 6G DD DD $s PP PP LL YY vY : 
RR RR PP PP 6G DD DD SS PP PP LL vY vY : 
RR RR PP PP 6G DD DD $s PP PP LL YY YY : 
RR RR PP PP GG DD DD SS PP PP LL YY YY : 
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RR RR PP GGGGGG  DDDDDDDD  SSSSSSSS PP LLELLLELLELL vY ae | ; 
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LL Il SS : 
LL Il SS | : 
LL I] SS | : 
LL II SS ; 
LL Il SSSSSS : 
LL Il SSSSSS | : 
LL Il SS : 
LL Il SS : 
LL I] 5S : 
LL II 5S 
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MODULE RPGSDSPLY( ZTITLE ‘DSPLY an item’ 
— = '1-004' ! file RPGDISPLY.B32 EDIT:DG1004 


BEGIN 


SRR AAA AAA AERA ERRATA AAA AAA AAA AAA AERA AAA KEE 


'# COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 
i® DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 
!® ALL RIGHTS RESERVED. 


:® roe SOFTWARE IS FURNISHED He ten LICENSE AND MAY SE USED AND COPIED 
:* ONLY IN ACCORDANCE WITH THE TER ne OF SUCH LICENSE AND WITH THE 
Hd INCLUSION OF THE ABOVE COPYRIGH) NOTICE. THIS SOFTWARE OR ANY OTHER 
:* COPIES THEREOF MAY NOT BE PR OVIDED OR OTHERWISE MADE AVAILABLE TO ANY 
!® OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY 


* 
® 
® 
® 
® 
* 
*® 
te 
® 
® 
ie TRANSFERRED. * 
® 
® 
*® 
® 
* 
® 
® 
® 
® 
* 


:* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
:* erepokat itn NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 
:* = 


t* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
!® SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


SRR R ARERR AERA EAA AREER AEE 
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9 1: 
$0 | ise 
31 ! 
3 } FACILITY: RPGII SUPPORT 
oe } ABSTRACT: 
36 ' This module contains the RTL routine that supports the RPG DSPLY 
0037 ‘ opcode. 
38 0038 : 
iB s't44 ENVIRONMENT: VAX/VMS user mode 
Bnet : AUTHOR: Debess Grabazs, CREATION DATE: 18-March-1983 
re 004 ! MODIFIED BY: 
44 0044 } 
45 0045 ! 1-001 - Original version. DG 18-Mar-1983. 
46 0046 ! 1-002 - use routine COBSSRET_A_AB_ PREV to get address of COBSSAB_PREV. 
47 0047 ! L 29-Aug-1983 
48 0048 ! 1-003 - erste _*onperers for overpunched numeric before calling 
49 0049 : COBSAC In case. f invalid entry, original value will 
50 0050 ! - ne DG 30 jhug- 19 
51 0051 ! 1-004 = Set RPG for gits rs) a COBSACC_SCR and COBSDISP_SCR. 
26 pO36 : DG 24-Oct-1983. 
5 005 ! 
54 0054 leo 
55 0055 ' <BLF /PAGE> 


F 12 
6-Sep=1984 92:13:33 YAX=11 Bliss-32_v4.0-74 p 
t-8ep=1984 18:00:17 — ERPGRTL SRESRPGDSPLY .039; 1 ome of 


RPGSDSPLY DSPLY an item 1 
eB Oe Declarations 1 


3 33 35 ! BSBTTL "Declarations' 
: 1 ! PROLOGUE FILE: 

>; 60 0 § 1 !- 

s 68h 0060 1 

3; 6 0061 1 REQUIRE 'RTLIN:RPGPROLOG'; ! Switches, PSECTs, macros, 

; © 01 § 1 ! Linkages and LIBRARYs 
>; 64 Bt 1 

: 65 128 1! | 
>; «666 0129 1 ! LINKAGES | 
; of 0130 1! NONE 

; 131 1 I- 
; & 1 § 1 

; 70 1 1 {4 

H 71 0134 1 ! TABLE OF CONTENTS: 

es BIR. 1 !- 

e ~. ¥ 0136 1 

3 74 0137 1 FORWARD ROUTINE 

$ 75 0138 #1 RPGSDSPLY: NOVALUE; 

; 0139 1 
eae 0140 1 !+ 

wae. 0141 1 ! INCLUDE FILES 

; B146 1! NONE 

; 80 01435 1 !- 

H 81 0144 «(1 

‘ § 0145 1 !4 
: 8 0146 1 ! MACROS 

; 4 0147 1! NONE | 
gs 89 0148 1! 

; 8686 0149 1 

: 87 0150 1 !+ 

; «88 0151 1 | EQUATED SYMBOLS 
B16 1! NONE 
> Se 0153 1 !- 

5; 0154 1 
;.% 0155 1 !+ 
; y 0156 1 ! EXTERNAL REFERENCES 

; 0157 1 !- 

: 95 0158 1 

; * 0159 1 EXTERNAL ROUTINE 

; «OWT 0160 1 COBSACC_SCR, ! ACCEPT with conversion 
; «98 0161 1 COBSDISP_SCR, ! DISPLAY with conversion | 
; B66 1 COBSS$RET_A_AB_PREV, ' Return address of table giving 

: 100 gi8 1 ! call pistory for advancing purposes 

; + 4 biee : LIBSSIGNAL; ! Signal warning and continue execution 

3 103 0166 1 EXTERNAL LITERAL , 

; 104 0167 1 RPG$_INVNUMENT; ! Invalid numeric entry warning | 
: 105 3168 1 

: 106 19? 1 EXTERNAL 

3; 107 0170 1 RPGS$BT7Z; ! Table for translate blank to zero 


| 
| 
| 
| 
eae 
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1-004 RPGSDSPLY - DSPLY an item 12-8 08- 1 3pe yee RPGRTL. SRC IRPGDSPLY .B3 31 . (3). 
; 109 171 1 ZSBTTL ‘RPGSDSPLY = DSPLY an item’ 
: 110 176 1 GLOBAL ROUTINE RPGSDSPLY( 
s 111 175 «1 FLAGS 
: 136 17%4 1 DISPLAY_FIELD: REF BLOCKE BYTE, 
ne 175 «1 ACCEPT _FIELD REF BLOCKL,BYTE 
: 116 178 1 ): NOVALUE = 
: 115 177 «1 
3 138 178 1 44 
: 11 179 1: 
: 118 4 ° : FUNCTIONAL DESCRIPTION: 
3 : 3 ¢ ! This routine supports the RPG DSPLY opcode. 
e% ¢ 0184 1 ! CALLING SEQUENCE: 
ws 3133 1! ? 
> 126 186 1! CALL RPGSDSPLY (flags.fl.v C,display_field.rx.dxJ 
: 125 0187 1! C,accept_field.mx.dx7) 
; 126 0188 #1! 
s 127 0189 1 ! FORMAL PARAMETERS: | 
: 128 0190 1! 
; 4 0191 1! flags bit 0 is set on if a comma should be 
; 130 O15 1! used in place of decimal point; bit 1 
s 1351 0195 1! is set on if blanks in an overpunched 
: 13§ 0194 1! numeric field should be treated as 
; 15 0195 1! equivalent to zeroes. 
: 134 0196 1! 
: 132 3934 : display_field data item whose value is displayed. 
4 } 
g tor 0199 1! accept_field data item whose value is displayed and 
s 138 0200 1! a new value is accepted into. 
3; «6139 0201 1! 
3; 140 OS08 1 ! IMPLICIT INPUTS: 
3 161 0203 1! 
: | 0204 1! NONE 
; 14 0205 1! 
: 144 0206 1 ! IMPLICIT OUTPUTS: 
3 145 0207 1! 
: 6146 0208 1! NONE 
: 147 0209 1! 
3; 148 0210 1 ! ROUTINE VALUE: | 
: 149 0211 1! 
; 150 bets 1! NONE 
s 151 02135 1! 
3 136 0214 1 ! SIDE EFFECTS: 
s 15 0215 1! 
3 «6154 0216 1! NONE 
: 155 asi? 1! 
; 156 0218 1 !-- 


aaa a aii kt kk a at at at 8 ot ot 2 2 = 2 SS 
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PB ANPPININPIPONPDNNINPYNIPINY 
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7 


1 o 
BEGIN 
LITERAL 
TRUE = 1, 
DISP = 0, 
DEC_IS_COMMA_BIT= 1, 
BT2 BIT = g 
CONVERT _BIT = 33, 
COMMA _BIT = 64 
PROTECT _BIT = 236 
RPG_BIT = 2048; 
LOCAL 


COBSSAB_PREV, 
DEV : WORD, 


FLAG 
NRO_FLAG : INITIAL 
TEMP _NRO : BLOCK [1 


» VECTO 


0), 
2 BYTE] VOLATILE, 
TEMPISTRING : R C15,BYTE); 


BUILTIN 
ACTUALCOUNT; 


'¢ 
' 


i Get address of history of previous call. 
: Note that using it this way will affect the 


: at the address, and not just the first byte. 


le 

COBSSAB_PREV = COBSSRET_A_AB_PREV(); 
'¢ 

! 

Set up FLAG parameter. 


le 

FLAG = CONVERT_BIT 
IF (.FLAGS AND~DEC 
THEN FLAG = .FLAG 


T: 
BIT) NEQ 0 
IT 


1s" CORMA 
= COMMA_B 
'+ 

' 


Deal with DISPLAY_FIELD. 


le 
if .DISPLAY_FIELD NEQ 0 
BEGIN 


IF (,DISPLAY_FIELDC 
((.FLAGS AND BTZ 
THEN 


H 12 
16-Sep-1984 
4-Sep-1984 


“i EQL DSC$K_ 
) 


AX-11 Oi leeeze v4. 35 
RPGRTL.SRCJRPGDSPLY.B32;1 


18:00:47 


Call history for advancing purposes 
2-byte array - 
device number + error 
handling decider 
Attributes bit vector 
Indicates if dealing with overpunched numeric 
Temporary string descriptor 
Temporary string - this assumes an overpunched 
numeric aor ine will only have, at most, 15 digits, 
a sign and a decimal point 


whole longword 


Conversion and RPG 


! Decimal is comma 


DTYPE_NRO) AND 


S 


bY an item 1 
DSPLY = DSPLY an item 1 


et ad et 
WN "OC OWNOUS WN —OVOOnu 


ny ee thers 
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Convert blanks to zeroes if flag is set. 
CHSTRANSLATE (RPGS$BTZ, 
DISPLAY FIELOCDSC$W_LENGTH], ,DISPLAY_F IELDCDSCS$A_POINTER] 
6, DISPLAY FIELOEDSCSU CENGTHS. DISPLAY FIELDEDSCSA. POINTER) ; 
"+ puree dite = DISP; ! Set up history for proper advancing 
; Display the field. 
COBSDISP_SCR (1, .DISPLAY_FIELD, .FLAG); 
END; 
'¢ 


; Deal with ACCEPT_FIELD. 


le 
iF ACTUAL COUNT () EQL 3 AND .ACCEPT_FIELD NEQ 0) 
BEGIN 
IF (,ACCEPT_FIELDCDSC$B_DTYPE] EQL DSC$K_DTYPE_NRO) AND 
(CFLAGS AND 8TZ_BITY NEQ 0) 
'+ 
Convert blanks to zeroes if flag is set. 
CHSTRANSLATE (RPGSBTZ, 
-ACCEPT FIELDCDSC$W_LENGTH], .ACCEPT_FIELDCDSCS$A_POINTER] 
0, .ACCEPT_FIELDCDSCS$W_LENGTH), .ACCEPT_FIELDCDSCSA_POINTER)); 
; COBSSAB_PREV = DISP; ! Set up history for proper advancing 
. Display the field. 
COBSDISP_SCR (1, .ACCEPT_FIELD, .FLAG); 


FLAG = .FLAG OR PROTECT _BIT; ! Protect 
WHILE TRUE DO 


Keep ACCEPTing until successful. 
BEGIN 


BIND 
ZERO = UPLIT ('0'); 


.COBS$AB_PREV = git, ' Set up history for proper advancing 
IF ACCEPT FIELD DSCSB_DTYPE] EQL DSC$K_DTYPE_NRO 
NRO_FLAG = TRUE; 
IF_.NRO-FLAG 
THEN 


BEGIN 


2D 
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COCDOOCO NII 
OOnO 


wr Oo 


BIZBPIVIBSSESSE 


aves 


SRVEAE 


SWIM OOOVNOUSWN oO 


POTOPONOPIAYD — — st 


- 
c 
. 
. 
. 
° 
~ 
o 
- 
° 
. 
7 
oe 
. 
oe 
. 
° 
- 
o 
. 
+ 
a 
2 
° 
© 
s 
. 
oe 
. 
eo 
. 
7 
. 
. 
7 
oe 
. 
° 
. 
° 
. 
. 
. 
° 
. 
° 
. 
° 
. 
a 
+ 
t 
. 
° 
7 
o 
* 
° 
. 
- 
. 
° 
7 
. 
. 
° 
. 
° 
. 
e 
a 
oe 
> 
° 
. 
° 
. 
€ 
. 
° 
+ 
e 
. 
e 
© 
o 
> 
. 
° 
° 
a 
o 
. 
° 
2 
° 
. 
. 
- 
a 
. 
e 
. 
° 
7 
a 
. 
. 
° 
. 
e 


HAAN NINA. BU BB TIO OE BEB BIO AAAOAOO UU 


WAWAIN NAAN AAAI AAAI AAAI AIA AA HII ino nono nononononononononononun) 


OnNOM 


horror 


Se 


IERIE eau ah? 


'¢ 

i Overpunched numeric string must a A cove becoune 

i yoesnt cc ere zeroes it out van dift 4 invalid 
input, the original string must be reoalaal le in 

i. case the user responds to the reprompt with a <CR>. 


TEMP_NRO [DSC$W_LENGTH] = .ACCEPT cies. COSCSW_ LENGTH]; 
TEMP_NRO [DSCS$B_DTY Ha Dscsk DTYPE_ NRO; 

a NRO [DSCSA eg tt: Er} - EMP. $ RING 

-ACCEPT_FIELB DSc$e 7CLASS EQ ini CLASS_SD 


BEGIN 


TEMP_NRO 
TEMP_NRO 
TEMP_NRO 


END 
ELSE 
TEMP_NRO CDOSC$B_CLASS) = DSC$K_CLASS_S; 


'¢ 
i Initialize the temporary string. 
CHSMOVE (. zeccert FIELD COSC$W_LENGTH], 


T FIE Eto CDSC$A_POINTERJ, 
iene” ESTRIN 


END; 


'¢ 
x Accept into the field. 
IF ( COBSACC_SCR (0, .NRO in 


N TEMP_N 
E TACCEPT. FIELD), 
0, 0, 0, 0) ) 


az 


THEN EXITLOOP 
ELSE 
BEGIN 
| “Error - print warning and re-prompt. 


LTBSS1GNAL (RPGS — 
. COBS$AB_PREV = BIS ! Set up history for proper advancing 


END; 
END; 
IF .NRO_FLAG 
wen 
: _Move accepted string from temporary to actual accept field. 


CHSMOVE ( ACCEPT FIELD cos¢sy genern TEMP_STRING, 
CCEPT_FIELD COSCSA_POINTER)); 


— 


CIRPGDSPLY. 83 31 
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e006 RPG DSPLY ° *DSPLY an item 10738b-1 382 9 b2:7 RPGRTL. SREIRPGDSPLY -03 B32;1 _ (4) | 


og a 


R 
1 


-TITLE RPGSDSPLY DSPLY an item 
. \1-004\ 


IDENT 

-PSECT _RPGSCODE,NOWRT, SHR, PIC,2 | 

00 00 00 30 00000 P.AAA: .ASCII \0\<0><0><0> ; ; 

ZERO= : 

.EXTRN copsace ch, COBSDISP_ SCR : 

“EXTRN COBSS$RET_A : 

~EXTRN CTBSSTENAL > ARPGS. YNVNUMENT 4 

"EXTRN RPGS$BTZ ; 

OFFC 00000 “ENTRY RPGSDSPLY, Save R2,R3,R4,R5,R6.R7.RB.RI,~ — ; 0172 ; 

5B 000000006 00 9€ 00002 MOVAB COBgD LSP. SCR, R11 : : 

Peds ED RB : : 

58 D4 Sb0Ts CLRL NR 28. oP PAG + 0219 : 

000000006 09 00 re 00015 CALLS #0," feessie pet PREV ; 0253 ; 

7 ongn Br Be Boone = Rua abe : 0260) | 

57 40 A? HH 00038 MOVAB Benes, LAG + 0262 : 

56 08 AC 09 900¢¢ 1$ MOVE DISPLAY FIELD, R6 ; 0269 ; 

13 02 AG 9 00052 CPE (R6), #19 ; 0273 : 

09 6C 21 4 00038 BBC #33, FLAGS : 0274 ; 
6A 00 04 B6 66 E 0005¢ MOVTC (R65, vette 0. RPGSBTZ, (R6), a4(R6) ; 0281 : 
69 D4 $b0as 2$ CLRL  (COBS$AB_PREV) > 0283 : 

: a ag hel 

6B 03 FB 0004C CALLS #3, COBSDISP_SCR : : 

03 6C 91 OO04F 38 CMPB CCAP), #3 : 0296 : 

01 13 0052 BEQL 4$ 2 

oc ac D3 Sbae 4$ TSTL ACCEPT_FIELD : : 

oo ie Be : 3 

56 0c AC pd 0058 5$: MOVL ACCEPT FIELD. R6 > 0300 : 

13 02 a6 91 05 CAPE 2(R6), # ; 

09 6C 2 ¢ We BC $33 FLAGS > 0301 : 
6A 00 04 86 6 £ 069 MOVTC (R65, ues, o 0. RPG$BTZ, (R6), a4(R6) ; 0308 : 
$3 4 i 6$ CLRL —(COBS$AB_ PREV) : 9310 : 

7E 6 7D 0007 MOVO R6, -(SPT > 0314 : 

01 DD 0 77 PUSHL n : : 

68 03 FB 00079 CALLS #3, COBSDISP_SCR : : 
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- RPGSDSPLY = DSPLY an item 1 Sep-19 4 Og iH RPGRTL. SRC IRPGDSPLY .B3 31 . (45 | 
57 0100-Ss BFC QOOTC BISW2 #256, FLAG : 0316! 
69 ps 7$ CLRL  (COBS$AB_PREV) ; 326 
13 02 Ag 91 CAPE g (RO). #19 : 03 
58 0 06 6 9 MOVL #1 NRO. FLA ¢ : 0329 
28 8 E C 8$ BLBC NRO_FLAG, 11$ + 0330 
10 AE 66 80 F MOVW (ROY, TE TEMP_NRO + 0339 
12 AE 1 0 E MOVB #19, TEMP_RRO+2 ; 0340 
14 AE 6E 9E 0009 MOVAB TEMP STRING, OT EMP NRO+4 + 0341 
09 03 As 91 00098 CMPB «3 (ROS, + 0342 
10 12 0009F BNEQ 9$ : 
13 AE 09 3 004} MOVB #9, TEMP_NRO+3 F 0346 
1 AE 08 A6 A MOVB  8(R6), TEMP_NRO+8 + 034 
19 AE 09 Ab 90 QOOAA MOVB  9(R6), TEMPNRO+9 + 0348 
04 11 OOOAF BRB 10$ + 0342 
13. AE 01 90 000B1 9$: MOVB. #1, TEMP_NRO+3 : 0352 
6E 04 86 66 ¢8 00085 10$:  MOVC3 £R6) BetReD TEMP_STRING + 0357 
7E 7C OOOBA 11$: CLRQ = = (SPJ : 0366 
ze 7C 000BC CLRQ = =(SP) ; 
57 DD 000BE PUSHL FLAG + 0369 
08 58 E 000¢ BLBC_ NRO FLAG, 12$ : 
50 24 AE SE 000C3 MOVAB TEMP_NRO, RO + 0366 
50 DD 000C7 PUSHL R ; 
02 11 000¢9 BRB 13$ : 
56 DD 000CB 128 PUSHL  R6 + 0368 
7E D4 000CD 13$ CLRL. (SP) : 0366 
000000006 00 07 FB OOOCF CALLS #7, COBSACC_SCR ; 
11 50 £8 00006 BLBS F 
000000006 8F DD 00009 PUSHL #RPG$_INVNUMENT : 0376 
000000006 00 01 FB OOODF CALLS #1, LYBSSIGNAL : 
69 D4 000E6 CLRL  (COBS$AB_PREV) : 0377 
97 11 O00E8 BRB : 0317 
05 58 £9 OOOEA 14$:  BLBC. NRO-FLAG, 15$ + 0383 
04 B86 6E 66 28 OO0ED MOVC3 (RO), TEMP_STRING, @4(R6) + 0389 
04 OOOF2 15$: RET : 0393 
; Routine Size: 243 bytes, Routine Base: _RPGSCODE + 0004 
333 0394 1 
: 334 0395 0 END ELUDOM 
: PSECT SUMMARY 
: Name Bytes Attributes 
: _RPGSCODE 247 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) 


; Library Statistics 


; Elapsed Time: 0963-9 
3; Lines/CPU Min: 3259 

3 Lexemes/CPU-Min: 14079 

: pee | Used: 103 pages 
: a 


; Compilation Complete 
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RPGSDSPLY DSPLY an item $=300° 3: AX-11 Bliss-32 V4.0-74 Page ‘ 
re8 RPGSDSPLY = DSPLY an item 12-888: 1382 ¢: bi ‘3 RPGRTL SREIRPCDSPLS 63551 . (4) 
2 ee be 7! ee -- Symbols -------- Pages Processing 

: File Total Loaded Percent Mapped Time 

: _$255$DUA28:(SYSLIBISTARLET.L32;1 9776 9 0 581 0:01.0 
; Ets RPGRTL.OBJJRP traci 32;1 54 0 0 9 $8 :90:3 | 
: COMMAND QUALIFIERS 

: BLISS/CHECK=(FIELD, INITIAL,OPTIMIZE) /NOTRACE/LIS=LIS$:RPGDSPLY/OBJ=OBJ$:RPGDSPLY MSRC$:RPGDSPLY/UPDATE=(ENH$:RPGDSPLY) 

; Size: 243 code + 4 data bytes 

; Run Time: 00:07.3 


QUIPMENT CORPORATION 
CONFIDENTIAL AND PROPRIETARY _ 


